home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / dev / basic / ACE_Prgs.lha / include / petr.lha / Petr.h < prev    next >
Encoding:
Text File  |  1995-02-01  |  7.9 KB  |  404 lines
  1. shortint Kontrola,m.a,m.b
  2.   'Kontrola - shared variable which is used in subs "in$" and "Innum!" 
  3.   'this variable returns 3,4,5,6 - if an cursor is pressed 
  4.   '                      and  10 - if esc is pressed(with included keymap)
  5.  
  6.   'm.a and m.b  - shared variable which is used in subs "mys",
  7.   '                                     "GAD%" and "Waitmouse"
  8.   ' m.a row of mouse click (1-25)
  9.   ' m.b column of mouse click (1-80)
  10.  
  11. dim t$(16)
  12. dim tg%(16,3)
  13.   'shared arrays used in subprogram "GAD%"
  14.   ' t$  gadgets texts
  15.   ' tg% (i,1)  row of gadget
  16.   ' tg% (i,2)  start column of gadget
  17.   ' tg% (i,3)  lenght of gadget
  18.  
  19.  
  20. SUB pause(dsecs%)
  21.  'waits for dsecs% / 10  seconds
  22.  Longint t
  23.  t=TIMER*10
  24.  WHILE ABS(t-(TIMER*10))<dsecs%
  25.  WEND
  26. END SUB
  27.  
  28. SUB NoSpace$(f$)
  29.   'this subprogram removes all characters with ascii code <33
  30.   shortint i
  31.   string s$ size 80,i$ size 4
  32.   for i=1 to len(f$)
  33.     i$=mid$(f$,i,1)
  34.     If asc(i$)>32 then s$=s$+i$
  35.   next i
  36.   NoSpace$=s$
  37. END SUB
  38.  
  39. SUB key$
  40.  'this subprogram waits for press of keyboard and returns pressed column
  41.     String i$ SIZE 2
  42.     Repeat
  43.      i$=inkey$
  44.     Until i$<>""
  45.     key$=i$
  46. END SUB 
  47.  
  48. SUB Mys
  49.  'this subprogram wait for mouse click and then returns
  50.  'mouse position in shared variables m.a (column) and m.b (row)
  51.  Shared m.a, m.b
  52.  SHORTINT h
  53.  String i$ SIZE 2
  54.  
  55. Repeat
  56.  h=MOUSE(0)          
  57.  If h<>0 THEN
  58.    m.a=INT(MOUSE(1)/8)+1
  59.    m.b=INT(MOUSE(2)/8)+1
  60.    EXIT SUB
  61.  End if
  62. until h<>0
  63. END SUB
  64.  
  65.  
  66. SUB BOX(x1%,x2%,y1%,y2%,col%,st%)
  67.   'this subprogram draw a 3D like box
  68.   'x1% - start x coordinate  (lines)
  69.   'x2% - end x coordinate  (lines)
  70.   'y1% - start y coordinate  (lines)
  71.   'y2% - end y coordinate  (lines)
  72.   'col% - color to fil the box
  73.   'st% - 0 to box up or 1 to box down
  74.   
  75.   shortint col1,col2
  76.   col1=abs(st%-1)
  77.   col2=st%
  78.   line (x1%,y1%)-(x2%,y2%),col%,bf
  79.   line (x1%,y1%)-(x2%,y1%),col1
  80.   line (x1%,y1%)-(x1%,y2%),col1
  81.   line (x1%,y2%)-(x2%,y2%),col2
  82.   line (x2%,y1%)-(x2%,y2%),col2
  83. END SUB
  84.  
  85.  
  86. SUB gline(ra%,sl%,de%,st%)
  87.   'this subprogram draw a 3D like box 1 row high and locate print to it
  88.   'sl% - start x coordinate  (columns)
  89.   'ra% - start y coordinate  (rows)
  90.   'de% - lenght of box in columns
  91.   'st% - 0 to box up or 1 to box down
  92.  
  93.   shortint col1,col2,x1,x2,y1,y2
  94.   col1=abs(st%-1)
  95.   col2=st%
  96.   x1=sl%*8-9
  97.   x2=(sl%+de%)*8-8
  98.   y1=ra%*8-9
  99.   y2=ra%*8
  100.   line (x1,y1)-(x2,y1),col1
  101.   line (x1,y1)-(x1,y2),col1
  102.   line (x1,y2)-(x2,y2),col2
  103.   line (x2,y1)-(x2,y2),col2
  104.   locate ra%,sl%
  105. END SUB
  106.  
  107. SUB PrTime
  108.   'this subprogram writes time and date on top right corner of screen
  109.   oldfg%=window(10)
  110.   color 3,2
  111.   box(496,592,13,35,2,0)
  112.   locate 3,69
  113.   Prints left$(time$,len(time$)-3)
  114.   locate 4,64
  115.   Prints Date$
  116.   color oldfg%,3
  117. END SUB
  118.  
  119. SUB in$(i%,j%,t$,n$,l%)
  120.   'this subprogram is for easy formatted input on custom screens
  121.   'i% - start row
  122.   'j% - start column
  123.   't$ - help text for input
  124.   'n$ - posible text for input
  125.   'l% - maximum/defeault lenght of text
  126.   'shared variable kontrola returns 3,4,5,6 - cursor; 10 - esc (with included keymap)
  127.  
  128.   PrTime
  129.   ON TIMER(10) gosub ICAS
  130.   TIMER ON
  131.   SHARED kontrola
  132.   SHORTINT a,d,m,Radic
  133.   STRING j$ SIZE 80
  134.    NULL$=""
  135.    m=0
  136.    d=0
  137.    Kontrola=0
  138.    Radic=0
  139.    color 1,3
  140.    If i%=0 then i%=csrlin+1
  141.    If j%=0 then j%=pos
  142.    n$=left$(n$,l%)
  143.    m=l%-LEN(n$)
  144.    LOCATE i%,j%
  145.   Prints t$;n$;Space$(m);
  146.    color 2,3
  147.    Prints "<"
  148.    j%=j%+LEN(t$)
  149.    LOCATE i%,j%
  150.    color 1,3
  151.    SOUND 1141.42,1,32,1
  152.    SOUND 906,2,32,0
  153.  
  154.    string i$ SIZE 2
  155.  
  156. Pokracovani:
  157.     i$=key$
  158.     a=asc(i$)
  159.  
  160.     If a=8 then
  161.       i$=NULL$
  162.       If d>0 then
  163.         j$=left$(j$,(d-1))
  164.         d=d-2
  165.        else
  166.     --d    
  167.       End if
  168.     End if
  169.  
  170.     If a=127 then
  171.         i$=NULL$
  172.         j$=NULL$
  173.         d=-1
  174.     End if
  175.  
  176.     If a=27 then
  177.        kontrola=10
  178.        goto Hotovo
  179.     End if
  180.  
  181.     If a=7 or (a>8 and a<13) then
  182.        kontrola=a-6
  183.        goto Hotovo
  184.     End if
  185.  
  186.     If a=13 then
  187.        goto Hotovo
  188.     End if
  189.  
  190.       If a>31 or a=8 then
  191.         j$=j$+i$
  192.         ++d
  193.         If d=l% then
  194.           goto Hotovo
  195.         End if
  196.         locate i%,j%
  197.         Prints j$;
  198.          color 3,3
  199.         Prints "|";
  200.          color 1,3
  201.         Prints space$(l%-d-1)
  202.       End if
  203.  
  204. goto Pokracovani
  205.  
  206. ICAS:
  207. PrTime
  208. locate i%,j%
  209. return
  210.  
  211. Hotovo:
  212.  LOCATE i%,j%
  213.  If j$=NULL$ THEN j$=n$ 
  214.  j$=left$(j$+space$(l%-d),l%)
  215.  Prints j$;space$(1)
  216.  in$=j$
  217. END SUB
  218.  
  219. SUB InNum!(i%,j%,t$,n$,l%)
  220.  'this subprogram is like in$, but for variables
  221.  Shared Kontrola
  222.  InNum!=Val(NoSpace$(in$(i%,j%,t$,n$,l%)))
  223. END SUB
  224.  
  225. SUB GAD%
  226.  'this subprogram draws gadgets with user text and returns the number of selected gadget
  227.  ' gadgets texts is in shared array t$
  228.  ' array tg% (i,1)  row of gadget
  229.  ' array tg% (i,2)  start column of gadget
  230.  ' array tg% (i,3)  lenght of gadget
  231.  ' gadgets can be selected by alt - cursor and Enter too
  232.   PrTime
  233.   ON TIMER(30) gosub GCAS
  234.   TIMER ON
  235.   shared tg%,t$
  236.   shortint i,n,vysl,h,zm,m.a,m.b,poz,pozst
  237.   String i$ SIZE 2
  238. repeat
  239.   ++n
  240. until tg%(n,3)=0
  241.   --n
  242. locate 2,2
  243.   color 0,2
  244.   for i=1 to n
  245.    gline(tg%(i,1),tg%(i,2),tg%(i,3),0)
  246.    If left$(t$(i),1)<>space$(1) then t$(i)=space$(1)+t$(i)
  247.    t$(i)=left$((t$(i)+space$(tg%(i,3))),tg%(i,3))
  248.    Prints t$(i)
  249.   next i
  250.  
  251.  
  252. REPEAT
  253.  m.a=0%
  254.  m.b=0%
  255.  zm =0%
  256.  
  257. REPEAT
  258.  i$=INKEY$
  259.  If i$<>"" then
  260.    If asc(i$)=10 then poz=poz+1
  261.    If asc(i$)= 9 then poz=poz-1
  262.    If asc(i$)=13 and poz<1000 and poz>0 then poz=poz+1000
  263.    zm=1000
  264.  End if
  265.  h=MOUSE(0)          
  266.  If h<>0 THEN
  267.   m.a=INT(MOUSE(1)/8)+1
  268.   m.b=INT(MOUSE(2)/8)+1
  269.   zm=1000
  270.  End if
  271. Until zm=1000
  272.  
  273.   locate 15,15
  274.   for i=1 to n
  275.    locate 15,10
  276.    If m.b=tg%(i,1) then
  277.      If m.a>=tg%(i,2) and m.a<(tg%(i,2)+tg%(i,3)) then
  278.        vysl=i
  279.        gline(tg%(i,1),tg%(i,2),tg%(i,3),1)
  280.      End if
  281.    End if
  282.   next i
  283.  
  284.   If poz<0 then poz=0
  285.   If poz>n and poz<1000 then poz=1
  286.   If poz>0 and poz<1000 then
  287.     gline(tg%(poz,1),tg%(poz,2),tg%(poz,3),1)
  288.     If pozst>0 then
  289.       gline(tg%(pozst,1),tg%(pozst,2),tg%(pozst,3),0)
  290.     End if
  291.     pozst=poz
  292.   End if
  293.   If poz>1000 then
  294.     gad%=poz-1000
  295.     EXIT SUB
  296.   End if
  297. until vysl>0
  298.  gad%=vysl
  299. EXIT SUB
  300.  
  301. GCAS:
  302. PrTime
  303. return
  304. END SUB
  305.  
  306. SUB  WaitMouse
  307.    'this subprogram show wait gadget and waits for selecting them
  308.   shared m.a,m.b
  309.   shortint i,h,j
  310.   h=window(10)
  311.   j=window(11)
  312.   i=CSRLIN            
  313.   box(276,348,180,195,3,0)
  314.   Gline(24,36,8,0)
  315.   color 1,j
  316.   Prints " O.K. ! "
  317.   repeat
  318.     MYS
  319.   until m.b=24 and m.a>35 and m.a<44 
  320.   line (275,179)-(350,196),j,bf
  321.   color h,j
  322.   LOCATE i,1 
  323. END SUB
  324.  
  325. SUB Using$(f$,b!,Dec%)
  326. ' this routine returns formatted string representation of rounded numeric value b!
  327. '    f$ - format :    "!" means not round
  328. '               "." inserts decimal point
  329. '                         any other character inserts digit position
  330. '    b! - number
  331. '    Dec% - rounding:  that means number of digits after decimal point
  332. '            it can be a negative value too
  333. ' for instance :     Using$("#####.##,123.567,1)  returns "  123.60"
  334. '            Using$("#####.!!,123.567,1)  returns "  123.57"
  335. '            Using$("#####.##,123.567,-1)  returns "  120.00"
  336.  
  337.   string r$ size 30
  338.   shortint cf,cr,df,dr,dz,de,lf,lr,sign
  339.   sign=sgn(b!)
  340.   b!=abs(b!)
  341.   If b!<.001 then b!=0
  342.   lf=len(f$)  
  343.   cf=instr(f$,".")-1
  344.   If cf<0 then cf=lf
  345.   df=lf-cf
  346.   dz=-df
  347.   If dz>-1 then dz=-1
  348.   If instr(f$,"!")<1 then 
  349.      If (-dz-1)>Dec% then dz=-Dec%-1
  350.   End if
  351.   b!=b!+5*10^dz
  352.  
  353.   r$=mid$(str$(b!),2,15)
  354.  
  355.   de=instr(r$,"E")
  356.   If de>0 then 
  357.     de=val(NoSpace$(mid$(r$,de+1)))
  358.     If de=7 then r$=mid$(str$(CLNG(b!/10)),2,15)+"0"
  359.     If de=8 then r$=mid$(str$(CLNG(b!/100)),2,15)+"00"
  360.     If de>8 then r$=string$(10,37)
  361.   End if
  362.  
  363.   cr=instr(r$,".")-1
  364.   lr=len(r$)
  365.   If cr<0 then cr=lr
  366.   dz=Dec%
  367.   if -dz>cf then dz=1-cf
  368.   If instr(f$,"!")<1 then 
  369.      If dz>0 then
  370.         r$=left$(r$,cr+1+dz)
  371.        else
  372.         r$=left$(r$,cr+dz)+string$(-dz,48)
  373.      End if
  374.   End if
  375.  
  376.   cr=instr(r$,".")-1
  377.   lr=len(r$)
  378.   If cr<0 then cr=lr
  379.   dr=lr-cr
  380.  
  381.  If df<=dr then
  382.    r$=left$(r$,(lr-dr+df))
  383.   else
  384.    If dr=0 then
  385.       r$=r$+"."
  386.       df=df-1
  387.    End if
  388.    r$=r$+string$((df-dr),48)
  389.  End if
  390.  
  391.   If sign<0 then 
  392.     r$="-"+r$
  393.     cr=cr+1
  394.   End if
  395.   If cf>=cr then
  396.     r$=space$(cf-cr)+r$
  397.    else
  398.     r$="%"+r$
  399.   End if
  400.  
  401.   Using$=r$
  402.   
  403. END SUB
  404.